home *** CD-ROM | disk | FTP | other *** search
/ Whiteline: Alpha / Whiteline Alpha.iso / progtool / prolog / booter.toy next >
Encoding:
Text File  |  1994-09-22  |  11.4 KB  |  230 lines
  1. % % % translator of Prolog-10 (mini) into TOY Prolog % % %
  2. transl(:0, :1) : see(:0) . tell(:1) . program . seen . told .
  3.          see(user) . tell(user) . display(translated(:0)) . nl . []
  4.                %% 0 from_file, 1 to_file
  5. % - - - - - - - - - - - - - - - - - - - - - -
  6. % main loop
  7. program : rch . skpb(:0) . tag(transl(:0)) . isendsym(:0) . ! . []
  8. program : program . []
  9. transl('#') : ! . rch . []
  10. transl('%') : comment('%', :0, []) . ! . puttr(:0) . []
  11. transl(:0) : clause(:0, :1, [], :2) . puttr(:1) . putvarnames(:2, 0) . []
  12.                %% 0 startch, 1 termrepr, 2 sym_tab
  13. isendsym('#') : []      % otherwise fail, i.e. loop
  14. % - - - - - - - - - - - - - - - - - - - - - -
  15. % error handling: skip to the nearest dot
  16. err(:0, :1) : display('*** error in ') . display(:0) .
  17.          display(': unexpected "') . display(:1) . lastch(:2) .
  18.          display('". text skipped: ') . b_skip(:2) . nl . tagfail(transl(_)) . []
  19.                %% 0 proc_name, 1 bad_item, 2 first_skipped_char
  20. b_skip('.') : wch('.') . []
  21. b_skip(:0) : wch(:0) . rch . lastch(:1) . b_skip(:1) . []
  22. % - - - - - - - - - - - - - - - - - - - - - -
  23. % a comment extends till end_of_line
  24. comment(:0, :0.:1, :1) : iseoln(:0) . []
  25.                %% 0 eoln, 1 rest_of_termrepr
  26. comment(:0, :0.:1, :2) : rch . lastch(:3) . comment(:3, :1, :2) . []
  27.                %% 0 char, 1 termrepr, 2 rest_of_termrepr, 3 nextchar
  28. % - - - - - - - - - - - - - - - - - - - - - -
  29. % read a goal
  30. clause(':', ':'.:0, :1, :2) : ! . ctail(':', :0, ' '.'#'.:1, :2) . []
  31.                %% 0 termrepr, 1 rest_of_termrepr, 2 sym_tab
  32. % read an assertion/rule
  33. clause(:0, :1, :2, :3) : fterm(:0, :4, :1, ' '.':'.:5, :3) .
  34.          ! . ctail(:4, :5, :2, :3) . []
  35.                %% 0 fterm_firstch, 1 termrepr, 2 rest_of_termrepr,
  36.                %% 3 sym_tab, 4 ctail_firstch, 5 middletermrepr
  37. clause(:0, _, _, _) : err(clause, :0) . []
  38. % - - - - - - - - - - - - - - - - - - - - - -
  39. % clause tail
  40. ctail('.', ' '.'['.']'.:0, :0, _) : ! . []
  41.                %% 0 rest_of_termrepr
  42. % righthand side of a non-unit clause, or a goal
  43. % eoln and blanks inserted to make the output look tidy
  44. ctail(':', :4.' '.' '.' '.:0, :1, :2) : rdch('-') . ! . iseoln(:4) .
  45.          rdchsk(:3) . ctailaux(:3, :0, :1, :2) . []
  46.                %% 0 termrepr, 1 rest_of_termrepr, 2 sym_tab, 3 calls_firstch,
  47.                %% 4 eoln
  48. ctail(:0, _, _, _) : err(ctail, :0) . []
  49. % get the righthand side of a clause (embedded comments will not be displaced)
  50. ctailaux('%', :0, :1, :2) : comment('%', :0, ' '.' '.' '.:5) . ! .
  51.          rdchsk(:3) . ctailaux(:3, :5, :1, :2) . []
  52.                %% 0 termrepr, 1 rest_of_termrepr, 2 sym_tab, 3 rest_firstch,
  53.                %% 5 middletermrepr
  54. ctailaux(:0, :1, :2, :3) : fterm(:0, :4, :1, ' '.'.'.:5, :3) .
  55.          fterms(:4, :5, :2, :3) . []
  56.                %% 0 fterm_firstch, 1 termrepr, 2 rest_of_termrepr,
  57.                %% 3 sym_tab, 4 fterms_firstch, 5 middletermrepr
  58. % a list of functor-terms (i.e. calls)
  59. fterms('.', ' '.'['.']'.:0, :0, _) : ! . []
  60.                %% 0 rest_of_termrepr
  61. % eoln and blanks - cf. ctail/2/
  62. fterms(',', :4.' '.' '.' '.:0, :1, :2) : ! . iseoln(:4) .
  63.          rdchsk(:3) . ctailaux(:3, :0, :1, :2) . []
  64.                %% 0 termrepr, 1 rest_of_termrepr, 2 sym_tab, 3 ctail_firstch,
  65.                %% 4 eoln
  66. fterms(:0, _, _, _) : err(fterms, :0) . []
  67. % - - - - - - - - - - - - - - - - - - - - - -
  68. % a functor-term
  69. fterm(:0, :1, ''''.:2, :3, :4) :
  70.          ident(:0, :5, :2, ''''.:6) . ! . args(:5, :1, :6, :3, :4) . []
  71.                %% 0 id_firstch, 1 terminator, 2 termrepr, 3 rest_of_termrepr,
  72.                %% 4 sym_tab, 5 id_terminator, 6 middletermrepr
  73. % identifiers: words, !, quoted names, symbols
  74. ident(:0, :1, :0.:2, :3) :
  75.          word_start(:0) . rdch(:4) . alphanums(:4, :1, :2, :3) . []
  76.                %% 0 id_firstch, 1 terminator, 2 termrepr,
  77.                %% 3 rest_of_termrepr, 4 nextch
  78. ident('!', :0, '!'.:1, :1) : rch . skpb(:0) . []
  79.                %% 0 terminator, 1 termrepr
  80. ident('''', :0, :1, :2) : rdch(:3) . qident(:3, :0, :1, :2) . []
  81.                %% 0 terminator, 1 termrepr, 2 rest_of_termrepr, 3 nextch
  82. ident(:0, :1, :0.:2, :3) :
  83.          symch(:0) . rdch(:4) . symbol(:4, :1, :2, :3) . []
  84.                %% 0 symb_firstch, 1 terminator, 2 termrepr,
  85.                %% 3 rest_of_termrepr, 4 nextch
  86. % quoted identifiers
  87. qident('''', :0, :1, :2) :
  88.          rdch(:3) . qidentail(:3, :0, :1, :2) . ! . []
  89.                %% 0 terminator, 1 termrepr, 2 rest_of_termrepr, 3 nextch
  90. qident(:0, :1, :0.:2, :3) : rdch(:4) . qident(:4, :1, :2, :3) . []
  91.                %% 0 char, 1 terminator, 2 termrepr,
  92.                %% 3 rest_of_termrepr, 4 nextch
  93. qidentail('''', :0, ''''.''''.:1, :2) :
  94.          rdch(:3) . qident(:3, :0, :1, :2) . []
  95.                %% 0 terminator, 1 termrepr, 2 rest_of_termrepr, 3 nextch
  96. qidentail(_, :0, :1, :1) : skpb(:0) . []
  97.                %% 0 terminator, 1 rest_of_termrepr
  98. % words and symbols
  99. alphanums(:0, :1, :0.:2, :3) :
  100.          alphanum(:0) . ! . rdch(:4) . alphanums(:4, :1, :2, :3) . []
  101.                %% 0 an_alphanum, 1 terminator, 2 termrepr,
  102.                %% 3 rest_of_termrepr, 4 nextch
  103. alphanums(_, :0, :1, :1) : skpb(:0) . []
  104.                %% 0 terminator, 1 rest_of_termrepr
  105. symbol(:0, :1, :0.:2, :3) :
  106.          symch(:0) . ! . rdch(:4) . symbol(:4, :1, :2, :3) . []
  107.                %% 0 a_symbolchar, 1 terminator, 2 termrepr,
  108.                %% 3 rest_of_termrepr, 4 nextch
  109. symbol(_, :0, :1, :1) : skpb(:0) . []
  110.                %% 0 terminator, 1 rest_of_termrepr
  111. % get argument list: nothing or a sequence of terms in round brackets
  112. args('(', :0, '('.:1, :2, :3) :
  113.          ! . rdchsk(:4) . terms(:4, :1, :2, :3) . rdchsk(:0) . []
  114.                %% 0 nextch, 1 termrepr, 2 rest_of_termrepr,
  115.                %% 3 sym_tab, 4 terms_firstch
  116. args(:0, :0, :1, :1, _) : []
  117.                %% 0 nextch, 1 rest_of_termrepr
  118. % get a sequence of terms
  119. terms(:0, :1, :2, :3) : term(:0, :4, :1, :5, inargs, :3) .
  120.          termstail(:4, :5, :2, :3) . []
  121.                %% 0 term_firstch, 1 termrepr, 2 rest_of_termrepr, 3 sym_tab,
  122.                %% 4 terminator, 5 middletermrepr
  123. termstail(')', ')'.:0, :0, _) : ! . []
  124.                %% 0 rest_of_termrepr
  125. termstail(',', ','.' '.:0, :1, :2) :
  126.          ! . rdchsk(:3) . terms(:3, :0, :1, :2) . []
  127.                %% 0 middletermrepr, 1 rest_of_termrepr, 2 sym_tab, 3 nextch
  128. termstail(:0, _, _, _) : err(termstail, :0) . []
  129. % - - - - - - - - - - - - - - - - - - - - - -
  130. % get a term (context used to force brackets around lists within lists)
  131. term(:0, :1, :2, :3, :4, :5) : t(:0, :1, :2, :3, :4, :5) . ! . []
  132.                %% 0 firstch, 1 terminator, 2 termrepr,
  133.                %% 3 rest_of_termrepr, 4 context, 5 sym_tab
  134. term(:0, _, _, _, _, _) : err(term, :0) . []
  135. t(:0, :1, :2, :3, _, :4) : variable(:0, :1, :2, :3, :4) . []
  136. t(:0, :1, :2, :3, inargs, :4) : list(:0, :1, :2, :3, :4) . []
  137. t(:0, :1, '('.:2, :3, inlist, :4) : list(:0, :1, :2, ')'.:3, :4) . []
  138. % a dirty patch for negative numbers
  139. t('-', :0, :1, :2, _, :3) :
  140.          rdch(:4) . numberorfterm(:4, :0, :1, :2, :3) . []
  141.                %% 0 terminator, 1 termrepr, 2 rest_of_termrepr,
  142.                %% 3 sym_tab, 4 nextch
  143. t(:0, :1, :2, :3, _, _) : number(:0, :1, :2, :3) . []
  144. t(:0, :1, :2, :3, _, :4) : fterm(:0, :1, :2, :3, :4) . []
  145. % - - - - - - - - - - - - - - - - - - - - - -
  146. numberorfterm(:0, :1, '-'.:2, :3, _) :
  147.          digit(:0) . ! . number(:0, :1, :2, :3) . []
  148.                %% 0 nextch, 1 terminator, 2 termrepr, 3 rest_of_termrepr
  149. numberorfterm(:0, :1, ''''.'-'.:2, :3, :4) :
  150.          symbol(:0, :5, :2, ''''.:6) . args(:5, :1, :6, :3, :4) . []
  151.                %% 0 nextch, 1 terminator, 2 termrepr, 3 rest_of_termrepr,
  152.                %% 4 sym_tab, 5 symbol_terminator, 6 middletermrepr
  153. % - - - - - - - - - - - - - - - - - - - - - -
  154. % get a variable
  155. variable(:0, :1, :2, :3, :4) : var_start(:0) . alphanums(:0, :1, :5, []) .
  156.          findv(:5, :2, :3, :4) . ! . []
  157.                %% 0 firstch, 1 terminator, 2 termrepr,
  158.                %% rest_of_termrepr, 4 sym_tab, 5 name
  159. findv('_'.[], '_'.:0, :0, _) : []   % no search: an anonymous variable
  160.                %% 0 rest_of_termrepr
  161. findv(:0, ':'.:1, :2, :3) : look(:0, 0, :4, :3) . setn(:4, :1, :2) . []
  162.                %% 0 name, 1 termrepr, 2 rest_of_termrepr, 3 sym_tab, 4 num
  163. % look always counts from 0 and finds the position of a name in the symtab
  164. look(:0, :1, :1, :0.:2) : []
  165.                %% 0 name, 1 num, 2 symtabtail
  166. look(:0, :2, :1, _.:3) : sum(:2, 1, :4) . look(:0, :4, :1, :3) . []
  167.                %% 0 name, 1 num, 2 currnum, 3 symtabtail, 4 currnumplus1
  168. % set a number: no more than two digits (should be enough)
  169. setn(:0, :1.:2, :2) : less(:0, 10) .
  170.          ordchr(:3, '0') . sum(:3, :0, :4) . ordchr(:4, :1) . []
  171.                %% 0 num, 1 char, 2 rest_of_termrepr, 3 k, 4 kplusnum
  172. setn(:0, :1, :2) : less(:0, 100) . prod(10, :3, :4, :0) .
  173.          setn(:3, :1, :5) . setn(:4, :5, :2) . []
  174.                %% 0 num, 1 termrepr, 2 rest_of_termrepr,
  175.                %% 3 numby10, 4 nummod10, 5 middletermrepr
  176. setn(:0, _, _) : err(setn, :0) . []
  177. % - - - - - - - - - - - - - - - - - - - - - -
  178. % get a list in square brackets
  179. list('[', :0, :1, :2, :3) : rdchsk(:4) . endlist(:4, :1, :2, :3) .
  180.          rdchsk(:0) . []
  181.                %% 0 terminator, 1 termrepr, 2 rest_of_termrepr,
  182.                %% 3 sym_tab, 4 nextch
  183. endlist(']', '['.']'.:0, :0, _) : []
  184.                %% 0 rest_of_termrepr
  185. endlist(:0, :1, :2, :3) :
  186.          term(:0, :4, :1, '.'.:5, inlist, :3) . ltail(:4, :5, :2, :3) . []
  187.                %% 0 firstch, 1 termrepr, 2 rest_of_termrepr,
  188.                %% 3 sym_tab, 4 nextch, 5 middletermrepr
  189. ltail(']', '['.']'.:0, :0, _) : ! . []
  190.                %% 0 rest_of_termrepr
  191. ltail('|', :0, :1, :2) : ! . rdchsk(:3) . variable(:3, ']', :0, :1, :2) . []
  192.                %% 0 termrepr, 1 rest_of_termrepr, 2 sym_tab, 3 nextch
  193. ltail(',', :0, :1, :2) : ! . rdchsk(:3) .
  194.          term(:3, :4, :0, '.'.:5, inlist, :2) . ltail(:4, :5, :1, :2) . []
  195.                %% 0 termrepr, 1 rest_of_termrepr, 2 sym_tab,
  196.                %% 3 term_firstch, 4 nextch, 5 middletermrepr
  197. ltail(:0, _, _, _) : err(ltail, :0) . []
  198. % - - - - - - - - - - - - - - - - - - - - - -
  199. % numbers: only natural ones
  200. number(:0, :1, :2, :3) : digit(:0) . digits(:0, :1, :2, :3) . []
  201.                %% 0 firstch, 1 non_digit, 2 termrepr, 3 rest_of_termrepr
  202. digits(:0, :1, :0.:2, :3) : digit(:0) .
  203.          ! . rdch(:4) . digits(:4, :1, :2, :3) . []
  204.                %% 0 firstch, 1 non_digit, 2 termrepr, 3 rest_of_termrepr,
  205.                %% 4 nextch
  206. digits(_, :0, :1, :1) : skpb(:0) . []
  207.                %% 0 non_digit, 1 rest_of_termrepr
  208. % - - - - - - - - - - - - - - - - - - - - - -
  209. % auxiliary tests
  210. word_start(:0) : smalletter(:0) . []
  211. var_start(:0) : bigletter(:0) . []
  212. var_start('_') : []
  213. % - - - - - - - - - - - - - - - - - - - - - -
  214. skpb(:0) : skipbl . lastch(:0) . []
  215. % - - - - - - - - - - - - - - - - - - - - - -
  216. % output the translation
  217. puttr([]) : ! . []
  218. puttr(:0.:1) : wch(:0) . puttr(:1) . []
  219. putvarnames(:0, _) : var(:0) . ! . nl . []
  220.                %% 0 sym_tab_end
  221. putvarnames(:0.:1, :2) : next_line(:2) . wch(' ') . display(:2) . puttr(' '.:0) .
  222.          wch(',') . sum(:2, 1, :3) . putvarnames(:1, :3) . []
  223.                %% 0 currname, 1 sym_tab_tail, 2 currnum, 3 nextnum
  224. next_line(:0) : prod(6, _, 0, :0) . ! . nl . display('   %%') . []
  225.                %% 0 a_multiple_of_line_size
  226. next_line(_) : []
  227. % % % the end % % %
  228. : display('"BOOTSTRAPPER" loaded.') . nl . seen . [] #
  229.  
  230.